PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/win/pascal/modal.exe/TEST.PAS

Pascal/Delphi Source File | 1993-05-23 | 5.3 KB | 221 lines

program test;

(*
   Test program for MODAL.PAS

   Implements a MsgBox procedure to demonstrate the modal window object.
   MsgBox procedure only partially supports the API MessageBox.

   Copyright (c) 1993 by Yasser Asmi  (CIS 71543,2252)
*)

{$A+,I-,R-,S-,V-,B-,G+,X+,W-}

uses
   wintypes, winprocs, win31, strings, objects, owindows, odialogs, bwcc,
   modal;

const
   id_test = 201;
   id_exit = 202;

type
   t_app = object (tapplication)
      procedure initmainwindow; virtual;
   end;

   p_main = ^t_main;
   t_main = object (t_cwindow)
      constructor init (aparent : pwindowsobject;
                        atitle, aid : pchar);
      procedure b_test (var msg : tmessage); virtual id_first + id_test;
      procedure b_exit (var msg : tmessage); virtual id_first + id_exit;
   end;


   p_msgbox  = ^t_msgbox;
   t_msgbox = object (t_modalwindow)
      constructor init (aparent : pwindowsobject;
                        atxt, acaption : pchar;
                        atexttype : word);

      procedure b_yes (var msg : tmessage); virtual id_first + id_yes;
      procedure b_no (var msg : tmessage); virtual id_first + id_no;

   end;


(*-- T_MSGBOX --*)

constructor t_msgbox.init;

(*
   calls t_modalwindow init
   centers the window
   assigns bwcc background
   creates a divider
   creates a groupbox
   creates a static control
   creates buttons using atexttype (partially supported)
*)

var
   p : pwindowsobject;


 procedure button (anid, xloc : integer;
                   default : boolean);

 begin
    p := new (pbutton, init (@self, anid, '',
              dux (xloc), duy (74), 64, 39, default));
 end;


begin
   inherited init (aparent, acaption, 'MSGBOX');

   center_wa (attr, dux (170), duy (116));
   cwndclass.hbrbackground := bwccgetpattern;

   p := new (pbdivider, init (@self, -1, '',
             dux (0), duy (66), dux (166), duy (2), false, false));

   p := new (pbgroupbox, init (@self, 100, '',
             dux (8), duy (8), dux (150), duy (50)));

   p := new (pbstatic, init (@self, 101, atxt,
             dux (13), duy (13), dux (140), duy (40), strlen (atxt)));

    case atexttype of
      mb_ok : button (id_ok, 65, true);
      mb_okcancel : begin
                       button (id_ok, 31, true);
                       button (id_cancel, 99, false);
                    end;
      mb_yesno : begin
                    button (id_yes, 31, true);
                    button (id_no, 99, false);
                 end;
   end;
end;


procedure t_msgbox.b_yes;

begin
   endwin (id_yes);
end;


procedure t_msgbox.b_no;

begin
   endwin (id_no);
end;



function msgbox (parent : pwindowsobject;
                 txt, caption : pchar;
                 texttype : word) : integer;

(*
   There are two ways of calling run_modal function.  The first one, which
   is commented out in this procedure, allowes you to access variables in
   your objects before destroying the object.  The second one is a
   one-liner.  This is useful when only retval is important.

   first method:
      p := new (p_modalwindow, init (...));
                                      -- set attributes here
      ret := run_modal (p, false);    -- call with false
                                      -- access variables here
      p^.done;                        -- must call done

    second method:
      ret := run_modal (p_modalwindow, init (...), true);
*)

var
   p : p_msgbox;

begin
{
   p := new (p_msgbox, init (parent, txt, caption, texttype));
   run_modal (p, false);
   msgbox := p^.retval;
   p^.done;
}

   msgbox := run_modal (new (p_msgbox, init (parent, txt, caption, texttype)), true);
end;


(*-- T_APP --*)

procedure t_app.initmainwindow;

begin
   mainwindow := new (p_main, init (nil, 'Modal Window Test', 'TEST'));
end;


(*-- T_MAIN --*)

constructor t_main.init;

var
   p : pobject;

begin
   inherited init (aparent, atitle, aid);
   enablekbhandler;
   attr.x := 0;
   attr.y := 0;
   cwndclass.hbrbackground := getstockobject (ltgray_brush);

   p := new (pbutton, init (@self, id_test, '&Test', 10, 10, 50, 26, true));
   p := new (pbutton, init (@self, id_exit, 'E&xit', 80, 10, 50, 26, false));
end;


procedure t_main.b_exit;

begin
   done;
end;


procedure t_main.b_test;

begin
   msgbox (@self, 'This message box is created using a ' +
                  'modal window without any dialog resources.  ' +
                  'Try clicking on the main ' +
                  'window of this application.',
                  'Modal Window', mb_ok);

   msgbox (@self, 'Similary, any other dialog can be written ' +
                  'using the modal window object and may contain ' +
                  'any of the OWL controls.',
                  'Modal Window', mb_ok);
   msgbox (@self, 'This allows you to create dialogs dynamically and ' +
                  'control the flow of the application.',
                  'Modal Window', mb_okcancel);
   msgbox (@self, 'Please see the T_MSGBOX.INIT in TEST.PAS and then ' +
                  'look at MODAL.PAS',
                  'Modal Window', mb_yesno);
end;


var
   app : t_app;

begin
   app.init ('TEST');
   app.run;
   app.done;
end.